home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / xlisp2.arc / XLJUMP.C < prev    next >
Text File  |  1985-01-01  |  2KB  |  104 lines
  1. /* xljump - execution context routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. /* external variables */
  6. extern CONTEXT *xlcontext;
  7. extern NODE *xlvalue;
  8. extern NODE *xlstack,*xlenv,*xlnewenv;
  9. extern int xltrace,xldebug;
  10.  
  11. /* xlbegin - beginning of an execution context */
  12. xlbegin(cptr,flags,expr)
  13.   CONTEXT *cptr; int flags; NODE *expr;
  14. {
  15.     cptr->c_flags = flags;
  16.     cptr->c_expr = expr;
  17.     cptr->c_xlstack = xlstack;
  18.     cptr->c_xlenv = xlenv;
  19.     cptr->c_xlnewenv = xlnewenv;
  20.     cptr->c_xltrace = xltrace;
  21.     cptr->c_xlcontext = xlcontext;
  22.     xlcontext = cptr;
  23. }
  24.  
  25. /* xlend - end of an execution context */
  26. xlend(cptr)
  27.   CONTEXT *cptr;
  28. {
  29.     xlcontext = cptr->c_xlcontext;
  30. }
  31.  
  32. /* xljump - jump to a saved execution context */
  33. xljump(cptr,type,val)
  34.   CONTEXT *cptr; int type; NODE *val;
  35. {
  36.     /* restore the state */
  37.     xlvalue = val;
  38.     xlstack = cptr->c_xlstack;
  39.     xlunbind(cptr->c_xlenv);
  40.     xlnewenv = cptr->c_xlnewenv;
  41.     xltrace = cptr->c_xltrace;
  42.  
  43.     /* call the handler */
  44.     longjmp(cptr->c_jmpbuf,type);
  45. }
  46.  
  47. /* xlgo - go to a label */
  48. xlgo(label)
  49.   NODE *label;
  50. {
  51.     CONTEXT *cptr;
  52.     NODE *p;
  53.  
  54.     /* find a tagbody context */
  55.     for (cptr = xlcontext; cptr; cptr = cptr->c_xlcontext)
  56.     if (cptr->c_flags & CF_GO)
  57.         for (p = cptr->c_expr; consp(p); p = cdr(p))
  58.         if (car(p) == label)
  59.             xljump(cptr,CF_GO,p);
  60.     xlfail("no target for go");
  61. }
  62.  
  63. /* xlreturn - return from a block */
  64. xlreturn(val)
  65.   NODE *val;
  66. {
  67.     CONTEXT *cptr;
  68.  
  69.     /* find a block context */
  70.     for (cptr = xlcontext; cptr; cptr = cptr->c_xlcontext)
  71.     if (cptr->c_flags & CF_RETURN)
  72.         xljump(cptr,CF_RETURN,val);
  73.     xlfail("no target for return");
  74. }
  75.  
  76. /* xlthrow - throw to a catch */
  77. xlthrow(tag,val)
  78.   NODE *tag,*val;
  79. {
  80.     CONTEXT *cptr;
  81.  
  82.     /* find a catch context */
  83.     for (cptr = xlcontext; cptr; cptr = cptr->c_xlcontext)
  84.     if ((cptr->c_flags & CF_THROW) && cptr->c_expr == tag)
  85.         xljump(cptr,CF_THROW,val);
  86.     xlfail("no target for throw");
  87. }
  88.  
  89. /* xlsignal - signal an error */
  90. xlsignal(emsg,arg)
  91.   char *emsg; NODE *arg;
  92. {
  93.     CONTEXT *cptr;
  94.  
  95.     /* find an error catcher */
  96.     for (cptr = xlcontext; cptr; cptr = cptr->c_xlcontext)
  97.     if (cptr->c_flags & CF_ERROR) {
  98.         if (cptr->c_expr)
  99.         xlerrprint("error",NULL,emsg,arg);
  100.         xljump(cptr,CF_ERROR,NULL);
  101.     }
  102.     xlfail("no target for error");
  103. }
  104.